Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-04/bipl.zip/PROGS.ZIP/IGREP.ICN

Text File | 1992-09-28 | 6KB | 189 lines

############################################################################
#
#    File:     igrep.icn
#
#    Subject:  Program to search in the style of egrep
#
#    Author:   Robert J. Alexander
#
#    Date:     January 28, 1992
#
###########################################################################
#
#  Program to emulate UNIX egrep, but using the enhanced regular
#  expressions supported by regexp.icn.  Options supported are nearly
#  identical to those supported by egrep (no -b:  print disk block
#  number).  There is one additional option, -E, to allow Icon-type
#  (hence C-type) string escape sequences in the pattern string.
#  BEWARE:  when -E is used, backslashes that are meant to be processed
#  in the regular expression context must be doubled.  The following
#  patterns are equivalent:
#
#    without -E:    '\bFred\b'
#    with    -E:    '\\bFred\\b'
#
#  To enable the -D option (intended mainly for debugging), the Icon
#  Program Library file "ximage" must be linked with this program.
#
############################################################################

procedure Usage(n)
   write(&errout,
      "igrep -- emulates UNIX egrep\n_
      Usage: igrep -Options [expression] filename..._
    \n    Options:_
    \n    c    print count of matching lines rather than actual lines_
    \n    h    don't display file names_
    \n    i    ignore case of letters_
    \n    l    list only the names of files containing matching lines_
    \n    n    precede lines with line numbers_
    \n    s    work silently -- display nothing_
    \n    v    invert search to display only lines that don't match_
    \n    e expr    useful if expressions starts with -_
    \n    E expr    expresson containing Icon escape sequences_
    \n    f file    take list of alternated expressions from \"file\"",
    if \xdump then
    "\n    D    dump compiled pattern and quit" else "")
   exit(n)
end

link options,regexp

procedure main(arg)
   local compiledPattern

   if *arg = 0 then Usage()
   Options(arg)
   compiledPattern := GetPattern(arg) |
         {write(&errout,"Bad pattern ",image(Pattern)) ; exit(2)}
   if \Dump then (\xdump)(compiledPattern)
   exit(ScanFiles(arg,compiledPattern))
end

global CountOnly, NoNames, NamesOnly, NumberLines, Out, Invert, Escapes,
      Pattern, PatternFile, Dump, Re_LeftmostShortest

procedure Options(arg)
   local opt

   opt := options(arg,"chilnsve:E:f:DS")
   CountOnly := opt["c"]
   NoNames := opt["h"]
   if \opt["i"] then Re_Filter := map
   NamesOnly := opt["l"]
   NumberLines := opt["n"]
   Out := if \opt["s"] then &null else &output
   Invert := opt["v"]
   Pattern := \opt["e" | "E"]
   Escapes := opt["E"]
   PatternFile := opt["f"]
   Dump := opt["D"]
   Re_LeftmostShortest := (\opt["S"],&null) | 1
   return opt
end

procedure GetPattern(arg)
   local f, sep

   if \PatternFile then {
      f := open(PatternFile) |
        stop("Can't open pattern file \"",PatternFile,"\"")
      (/Pattern := "" & sep := "") | (sep := "|")
      while Pattern ||:= sep || read(f) do sep := "|"
      close(f)
      }
   /Pattern := get(arg)
   if /Pattern then Usage(2)
   return RePat(if \Escapes then istring(Pattern) else Pattern)
end

procedure ScanFiles(arg,pattern)
   local errors, Re_Longest, totalCount, fn, f, header, lineNbr, count
   local line, status, lineNbrTag

   Re_Longest := 1
   totalCount := 0
   if *arg = 0 then arg := ["-"]
   every fn := !arg do {
      f := if fn == "-" then &input else open(fn) |
            {write(&errout,"Can't open \"",fn,"\" -- skipped") ; errors := 2 ;
        next}
      header := if \NoNames | *arg = 1 then &null else fn || ":"
      lineNbr := count := 0
      while line := read(f) do {
         lineNbr +:= 1
         line := (\Re_Filter)(line)
         status := ReFind(pattern,line) | &null
     status := if \Invert then (\status,&null) | 1
         if \status then {
        count +:= 1
        if count = 1 & \NamesOnly then {write(\Out,fn) ; next}
        lineNbrTag := if \NumberLines then lineNbr || ":" else &null
        if not \(CountOnly | NamesOnly) then
          write(\Out,header,lineNbrTag,line)
        }
         }
      close(f)
      if \CountOnly then write(header,count)
      totalCount +:= count
      }
   ## if \CountOnly & *arg > 1 then write(\Out,"** Total ** ",totalCount)
   return \errors | if totalCount = 0 then 1 else 0
end

#
#  istring() -- Procedure to convert a string containing special escape
#  constructs, of the same format as Icon source language character
#  strings, to their true string representation.  Value returned is the
#  string with special constructs converted to their respective
#  characters.
#

procedure istring(s)
  local r,c
  r := ""
  s ? {
    while r ||:= tab(upto('\\')) do {
      move(1)
      r ||:= case c := map(move(1)) of {
    "b": "\b"        # backspace
    "d": "\d"        # delete (rubout)
    "e": "\e"        # escape (altmode)
    "f": "\f"        # formfeed
    "l": "\l"        # linefeed (newline)
    "n": "\n"        # newline (linefeed)
    "r": "\r"        # carriage return
    "t": "\t"        # horizontal tab
    "v": "\v"        # vertical tab
    "x": istring_radix(16,2)# hexadecimal code
    "^": char(ord(move(1)) % 32) | break # control code
    default: {        # either octal code or non-escaped character
      if any('01234567',c) then {    # if octal digit
        move(-1)
        istring_radix(8,3)
      }
      else c            # else non-escaped character
    } | break
      }
    }
    r ||:= tab(0)
  }
  return r
end

procedure istring_radix(r,max)
  local n,d,i,c
  d := "0123456789abcdef"[1:r + 1]
  n := 0
  every 1 to max do {
    c := move(1) | break
    if not (i := find(map(c),d) - 1) then {
      move(-1)
      break
    }
    n := n * r + i
  }
  return char(n)
end